home *** CD-ROM | disk | FTP | other *** search
/ Reverse Code Engineering RCE CD +sandman 2000 / ReverseCodeEngineeringRceCdsandman2000.iso / RCE / Library / Manuels & Misc / Assembly / AOA.ZIP / CH02 / EQNTRUTH / CANONU.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1995-12-18  |  11.1 KB  |  435 lines
  1. unit Canonu;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  7.   Forms, Dialogs, ExtCtrls, StdCtrls, Aboutu;
  8.  
  9. type
  10.  
  11.   TLogEqns = class(TForm)
  12.     InputEqn: TEdit;
  13.     Label1: TLabel;
  14.  
  15.     tt00: TPanel;
  16.     tt01: TPanel;
  17.     tt02: TPanel;
  18.     tt03: TPanel;
  19.     tt10: TPanel;
  20.     tt11: TPanel;
  21.     tt12: TPanel;
  22.     tt13: TPanel;
  23.     tt20: TPanel;
  24.     tt21: TPanel;
  25.     tt22: TPanel;
  26.     tt23: TPanel;
  27.     tt30: TPanel;
  28.     tt31: TPanel;
  29.     tt32: TPanel;
  30.     tt33: TPanel;
  31.  
  32.     ba00: TLabel;
  33.     ba01: TLabel;
  34.     ba10: TLabel;
  35.     ba11: TLabel;
  36.     dc00: TLabel;
  37.     dc01: TLabel;
  38.     dc10: TLabel;
  39.     dc11: TLabel;
  40.     ExitBtn: TButton;
  41.     AboutBtn: TButton;
  42.     ComputeBtn: TButton;
  43.     Eqn1: TLabel;
  44.     Eqn2: TLabel;
  45.     PrintBtn: TButton;
  46.     PrintDialog: TPrintDialog;
  47.     procedure FormCreate(Sender: TObject);
  48.     procedure ExitBtnClick(Sender: TObject);
  49.     procedure AboutBtnClick(Sender: TObject);
  50.     procedure PrintBtnClick(Sender: TObject);
  51.     procedure ComputeBtnClick(Sender: TObject);
  52.     procedure InputEqnChange(Sender: TObject);
  53.   private
  54.     { Private declarations }
  55.   public
  56.     { Public declarations }
  57.   end;
  58.  
  59. var
  60.   LogEqns: TLogEqns;
  61.  
  62. implementation
  63.  
  64. type
  65.  
  66.   TPType = array [0..1,0..1,0..1,0..1] of TPanel;
  67.  
  68. var
  69.   tt: TPType;
  70.  
  71.  
  72. {$R *.DFM}
  73.  
  74.  
  75.  
  76. (* ComputeEqn-    Computes the logic equation string from the current    *)
  77. (*         truth table entries.                    *)
  78.  
  79. procedure ComputeEqn;
  80.  
  81.     { ApndStr-    item contains '0' or '1' -- the character in the}
  82.     {        current truth table cell.  theStr is a string    }
  83.     {        of characters to append to the equation if item    }
  84.     {        is equal to '1'.                }
  85.  
  86.     procedure ApndStr(item:char; const theStr:string);
  87.     begin
  88.  
  89.       with LogEqns do begin
  90.  
  91.         { To make everything fit on our form, we have to break    }
  92.         { the equation up into two lines.  If the first line    }
  93.         { hits 66 characters, append the characters to the end    }
  94.         { of the second string.                    }
  95.  
  96.         if (length(eqn1.Caption) < 66) then begin
  97.  
  98.            { If we are appending to the end of EQN1, we have to    }
  99.            { check to see if the string's length is zero.  If    }
  100.            { not, then we need to stick ' + ' between the    }
  101.            { existing string and the string we are appending.    }
  102.            { If the string length is zero, this is the first    }
  103.            { minterm so we don't prepend the ' + '.        }
  104.  
  105.            if (item = '1') then
  106.             if (length(eqn1.Caption) = 0) then
  107.                      eqn1.Caption := theStr
  108.             else eqn1.Caption :=  eqn1.Caption + ' + ' + theStr;
  109.         end
  110.         else if (item = '1') then
  111.             eqn2.Caption :=  eqn2.Caption + ' + ' + theStr;
  112.  
  113.       end;
  114.  
  115.     end;
  116.  
  117.  
  118. begin
  119.  
  120.     with LogEqns do begin
  121.  
  122.  
  123.         eqn1.Caption := '';
  124.         eqn2.Caption := '';
  125.  
  126.     { Determine if two variable truth table.  tt12    }
  127.         { will only be visible if we've got a three or    }
  128.         { four variable truth table.            }
  129.  
  130.         if (not tt12.Visible) then begin
  131.  
  132.             { Test the 2x2 square in the upper left    }
  133.             { hand corner of the truth table and build    }
  134.             { the logic equation from the values in    }
  135.             { these squares.                }
  136.  
  137.             ApndStr(tt00.Caption[1],'B''A''');
  138.             ApndStr(tt01.Caption[1],'B''A');
  139.             ApndStr(tt10.Caption[1], 'BA''');
  140.             ApndStr(tt11.Caption[1], 'BA');
  141.  
  142.  
  143.         end
  144.         else begin {We've got three or four variables here }
  145.  
  146.             { See if three or four variable truth table    }
  147.             { tt20 will only be visible if we have a    }
  148.             { four variable truth table.        }
  149.  
  150.             if (not tt20.Visible) then begin
  151.  
  152.                 { Build the logic equation from the top    }
  153.                 { eight squares in the truth table.    }
  154.  
  155.                 ApndStr(tt00.Caption[1],'C''B''A''');
  156.                 ApndStr(tt01.Caption[1],'C''B''A');
  157.                 ApndStr(tt02.Caption[1], 'C''BA''');
  158.                 ApndStr(tt03.Caption[1], 'C''BA');
  159.  
  160.                 ApndStr(tt10.Caption[1],'CB''A''');
  161.                 ApndStr(tt11.Caption[1],'CB''A');
  162.                 ApndStr(tt12.Caption[1], 'CBA''');
  163.                 ApndStr(tt13.Caption[1], 'CBA');
  164.  
  165.             end
  166.             else begin {We've got a four-variable truth table    }
  167.  
  168.                 { Build the logic equation from all the squares    }
  169.                 { in the truth table.                }
  170.  
  171.                 ApndStr(tt00.Caption[1],'D''C''B''A''');
  172.                 ApndStr(tt01.Caption[1],'D''C''B''A');
  173.                 ApndStr(tt02.Caption[1], 'D''C''BA''');
  174.                 ApndStr(tt03.Caption[1], 'D''C''BA');
  175.  
  176.                 ApndStr(tt10.Caption[1],'D''CB''A''');
  177.                 ApndStr(tt11.Caption[1],'D''CB''A');
  178.                 ApndStr(tt12.Caption[1], 'D''CBA''');
  179.                 ApndStr(tt13.Caption[1], 'D''CBA');
  180.  
  181.                 ApndStr(tt20.Caption[1],'DC''B''A''');
  182.                 ApndStr(tt21.Caption[1],'DC''B''A');
  183.                 ApndStr(tt22.Caption[1], 'DC''BA''');
  184.                 ApndStr(tt23.Caption[1], 'DC''BA');
  185.  
  186.                 ApndStr(tt30.Caption[1],'DCB''A''');
  187.                 ApndStr(tt31.Caption[1],'DCB''A');
  188.                 ApndStr(tt32.Caption[1], 'DCBA''');
  189.                 ApndStr(tt33.Caption[1], 'DCBA');
  190.  
  191.             end;
  192.  
  193.         end;
  194.  
  195.         { If after all the above the string is empty, then we've got a    }
  196.         { truth table that contains all zeros.  Handle that special    }
  197.         { case down here.                        }
  198.  
  199.         if (length(eqn1.Caption) = 0) then
  200.            eqn1.Caption := '0';
  201.         Eqn1.Caption := 'F= ' + Eqn1.Caption;
  202.  
  203.     end;
  204.  
  205. end;
  206.  
  207.  
  208.  
  209. procedure TLogEqns.FormCreate(Sender: TObject);
  210. begin
  211.  
  212.     tt[0,0,0,0] := tt00;
  213.     tt[0,0,0,1] := tt01;
  214.     tt[0,0,1,0] := tt02;
  215.     tt[0,0,1,1] := tt03;
  216.  
  217.     tt[0,1,0,0] := tt10;
  218.     tt[0,1,0,1] := tt11;
  219.     tt[0,1,1,0] := tt12;
  220.     tt[0,1,1,1] := tt13;
  221.  
  222.     tt[1,0,0,0] := tt20;
  223.     tt[1,0,0,1] := tt21;
  224.     tt[1,0,1,0] := tt22;
  225.     tt[1,0,1,1] := tt23;
  226.  
  227.     tt[1,1,0,0] := tt30;
  228.     tt[1,1,0,1] := tt31;
  229.     tt[1,1,1,0] := tt32;
  230.     tt[1,1,1,1] := tt33;
  231.  
  232. end;
  233.  
  234. procedure TLogEqns.ExitBtnClick(Sender: TObject);
  235. begin
  236.  
  237.     Halt;
  238.  
  239. end;
  240.  
  241. procedure TLogEqns.AboutBtnClick(Sender: TObject);
  242. begin
  243.     AboutBox.Show;
  244. end;
  245.  
  246. procedure TLogEqns.PrintBtnClick(Sender: TObject);
  247. begin
  248.  
  249.     if (PrintDialog.Execute) then
  250.             LogEqns.Print;
  251.  
  252. end;
  253.  
  254. procedure TLogEqns.ComputeBtnClick(Sender: TObject);
  255. var
  256.     Equation :    string;
  257.     CurChar  :    integer;
  258.     dest,
  259.     i:        integer;
  260.  
  261.     { Parse- Parses the "Equation" string and evaluates it.    }
  262.     { Returns the equation's value if legal expression, returns    }
  263.     { -1 if the equation is syntactically incorrect.        }
  264.     {                                }
  265.     { Grammar:                            }
  266.     {        S -> X + S | X                    }
  267.     {        X -> YX | Y                    }
  268.     {        Y -> Y' | Z                    }
  269.     {        Z -> a | b | c | d | ( S )            }
  270.  
  271.     function parse(D, C, B, A:integer):integer;
  272.  
  273.         function X(D,C,B,A:integer):integer;
  274.  
  275.             function Y(D,C,B,A:integer):integer;
  276.  
  277.                     function Z(D,C,B,A:integer):integer;
  278.                         begin
  279.  
  280.                                 case (Equation[CurChar]) of
  281.  
  282.                         '(': begin
  283.  
  284.                                     CurChar := CurChar + 1;
  285.                                         Result := parse(D,C,B,A);
  286.                                         if (Equation[CurChar] <> ')') then
  287.                                             Result := -1
  288.                                         else    CurChar := CurChar + 1;
  289.  
  290.                                      end;
  291.  
  292.                                 'a': begin
  293.  
  294.                                     CurChar := CurChar + 1;
  295.                                         Result := A;
  296.  
  297.                                      end;
  298.  
  299.                                 'b': begin
  300.  
  301.                                     CurChar := CurChar + 1;
  302.                                         Result := B;
  303.  
  304.                                      end;
  305.  
  306.                                 'c': begin
  307.  
  308.                                     CurChar := CurChar + 1;
  309.                                         Result := C;
  310.  
  311.                                      end;
  312.  
  313.                                 'd': begin
  314.  
  315.                                     CurChar := CurChar + 1;
  316.                                         Result := D;
  317.  
  318.                                      end;
  319.  
  320.  
  321.                                 '0': begin
  322.  
  323.                                     CurChar := CurChar + 1;
  324.                                         Result := 0;
  325.  
  326.                                      end;
  327.  
  328.  
  329.                                 '1': begin
  330.  
  331.                                     CurChar := CurChar + 1;
  332.                                         Result := 1;
  333.  
  334.                                      end;
  335.  
  336.                                 else Result := -1;
  337.  
  338.                                 end;
  339.                         end;
  340.  
  341.                 begin {Y}
  342.  
  343.                     { Note: This particular operation is left recursive    }
  344.                     { and would require considerable grammar transform-    }
  345.                     { ation to repair.  However, a simple trick is to    }
  346.                     { note that the result would have tail recursion    }
  347.                     { which we can solve iteratively rather than recur-    }
  348.                     { sively.  Hence the while loop in the following    }
  349.                     { code.                        }
  350.  
  351.                     Result := Z(D,C,B,A);
  352.                     while (Result <> -1) and (Equation[CurChar] = '''') then
  353.                     begin
  354.  
  355.                         Result := Result xor 1;
  356.                         CurChar := CurChar + 1;
  357.  
  358.                     end;
  359.                 end;
  360.  
  361.         begin {X}
  362.  
  363.             Result := Y(D,C,B,A);
  364.                 if (Result <> -1) and (Equation[CurChar] <> chr(0)) then
  365.                     Result := Result AND X(D,C,B,A);
  366.         end;
  367.  
  368.     begin
  369.  
  370.         Result := X(D,C,B,A);
  371.         if (Result <> -1) and (Equation[CurChar] = '+') then begin
  372.  
  373.             CurChar := CurChar + 1;
  374.             Result := Result OR parse(D, C, B, A);
  375.         end;
  376.  
  377.     end;
  378.  
  379.  
  380. var
  381.     a, b, c, d:integer;
  382.  
  383. begin {ComputeBtnClick}
  384.  
  385.     Equation :=  LowerCase(InputEqn.Text) + chr(0);
  386.  
  387.     { Remove any spaces present in the string }
  388.  
  389.     dest := 1;
  390.     for i := 1 to length(Equation) do
  391.         if (Equation[i] <> ' ') then begin
  392.  
  393.             Equation[dest] := Equation[i];
  394.                 dest := dest + 1;
  395.  
  396.         end;
  397.  
  398.     { Okay, see if this string is syntactically legal.    }
  399.  
  400.     CurChar := 1;    {Start at position 1 in string    }
  401.  
  402.     if (Parse(0,0,0,0) <> -1) then begin
  403.  
  404.         { Compute the values for each of the squares in    }
  405.         { the truth table.                }
  406.  
  407.         for d := 0 to 1 do
  408.           for c := 0 to 1 do
  409.             for b := 0 to 1 do
  410.               for a := 0 to 1 do begin
  411.  
  412.                 CurChar := 1;
  413.                 if (parse(d,c,b,a) = 0) then
  414.                     tt[d,c,b,a].Caption := '0'
  415.                 else    tt[d,c,b,a].Caption := '1';
  416.  
  417.               end;
  418.  
  419.         ComputeEqn;
  420.         InputEqn.Color := clWindow;
  421.  
  422.     end
  423.     else InputEqn.Color := clRed;
  424.  
  425.  
  426. end;
  427.  
  428.  
  429. procedure TLogEqns.InputEqnChange(Sender: TObject);
  430. begin
  431.     ComputeBtn.Default := true;
  432. end;
  433.  
  434. end.
  435.